home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swags_z.zip / SOUND.SWG / 0050_FM Synth Code.pas < prev    next >
Pascal/Delphi Source File  |  1994-08-25  |  5KB  |  169 lines
  1. {
  2.   I got FM-synth code for the PAS (originally for the SB).  Here it is:
  3. }
  4. Program fmtest;
  5. uses
  6.   sbfm, crt;
  7. const
  8.   instrument: TFMInstrument = (SoundCharacteristic: ($11, $1);
  9.                                Level: ($8A, $40);
  10.                                AttackDecay: ($F0, $F0);
  11.                                SustainRelease: ($FF, $B3);
  12.                                WaveSelect: ($01, $00);
  13.                                FeedBack: $00;
  14.                                Filler: ($06, $00, $00, $00, $00, $00));
  15.   notes: array[0..12] of integer = ($157, $16B, $181, $198, $1B0, $1C1, $1E5,
  16.         $202, $220, $241, $263, $287, $2AE);
  17. begin
  18.   SbFMReset;
  19.   SbFMSetVoice(0,@instrument);
  20.   SbFMSetVoice(1,@instrument);
  21.   SbFMSetVoice(11,@instrument);
  22.   SbFMSetVoice(12,@instrument);
  23.  
  24.   SbFMKeyOn(0,notes[0],2);
  25.   delay(250);
  26.   SbFMKeyOn(1,notes[4],3);
  27.   delay(250);
  28.   SbFMKeyOn(1,notes[7],3);
  29.   delay(250);
  30.   SbFMKeyOn(1,notes[12],3);
  31.   delay(1000);
  32.  
  33.   sbFMKeyOff(0);
  34.   sbFMKeyOff(1);
  35.   sbFMKeyOff(11);
  36.   sbFMKeyOff(12);
  37.   sbFMReset;
  38. end.
  39.  
  40. Unit SbFM;
  41. interface
  42. type
  43.   PFMInstrument = ^TFMInstrument;
  44.   TFMInstrument = record
  45.                     SoundCharacteristic:array[0..1] of byte;
  46.                     Level:              array[0..1] of byte;
  47.                     AttackDecay:        array[0..1] of byte;
  48.                     SustainRelease:     array[0..1] of byte;
  49.                     WaveSelect:         array[0..1] of byte;
  50.                     Feedback:           byte;
  51.                     filler:             array[0..5] of byte;
  52.                   end;
  53. const
  54.   SbIOAddr=$220;
  55.   LeftFmAddress=0;
  56.   RightFmAddress=2;
  57.   FMADDRESS=$08;
  58. Procedure WriteFM(chip, addr, data: byte);
  59. Procedure SbFmReset;
  60. Procedure SbFMKeyOff(voice: integer);
  61. Procedure SbFMKeyOn(voice, freq, octave: integer);
  62. Procedure SbFMVoiceVolume(voice, vol: integer);
  63. procedure sbFMSetVoice(voicenum: integer; Ins: PFMInstrument);
  64. implementation
  65. Procedure WriteFM(chip, addr, data: byte);
  66. var
  67.   ChipAddr:                                integer;
  68.   t:                                        byte;
  69. begin
  70.   if chip>0 then chipaddr:=SbIOAddr + RightFMAddress else
  71.                chipaddr:=sbIOAddr + LeftFMAddress;
  72.   chipaddr:=SbIOAddr + FMAddress;
  73.   asm
  74.     push dx
  75.     push ax
  76.     push cx
  77.     mov dx,chipaddr
  78.     mov al,addr
  79.     out dx,al
  80.     in al,dx
  81.     inc dx
  82.     mov al,data
  83.     out dx,al
  84.     dec dx
  85.     mov cx,4
  86. @L:
  87.     in al,dx
  88.     loop @L
  89.     pop cx
  90.     pop ax
  91.     pop dx
  92.   end;
  93. end;
  94. Procedure SbFmReset;
  95. Begin
  96.   WriteFM(0, 1, 0);
  97.   WriteFM(1, 1, 0);
  98. end;
  99. Procedure SbFMKeyOff(voice: integer);
  100. var
  101.   regnum:                                byte;
  102.   chip:                                        integer;
  103. begin
  104.   chip:=voice div 11;
  105.   regnum:=$B0 + (voice mod 11);
  106.   WriteFM(chip, regnum, 0);
  107. end;
  108. Procedure SbFMKeyOn(voice, freq, octave: integer);
  109. var
  110.   regnum, t:                                byte;
  111.   chip:                                        integer;
  112. begin
  113.   chip:=voice div 11;
  114.   regnum:=$A0 + (voice mod 11);
  115.   WriteFM(chip, regnum, freq and $FF);
  116.   regnum:=$B0 + (voice mod 11);
  117.   t:=(freq shr 8) or (octave shl 2) or $20;
  118.   WriteFM(chip, regnum, t);
  119. end;
  120. Procedure SbFMVoiceVolume(voice, vol: integer);
  121. var
  122.   regnum:                                byte;
  123.   chip:                                        integer;
  124. begin
  125.   chip:=voice div 11;
  126.   regnum:=$40 + (voice mod 11);
  127.   WriteFM(chip, regnum, vol);
  128. end;
  129. procedure sbFMSetVoice(voicenum: integer; Ins: PFMInstrument);
  130. var
  131.   opcellnum:                                byte;
  132.   celloffset, i, chip:                        integer;
  133. begin
  134.   chip:=voicenum div 11;
  135.   voicenum:=voicenum mod 11;
  136.   celloffset:=(voicenum mod 3) + ((voicenum div 3) shr 3);
  137.   opcellnum:=$20 + celloffset;
  138.   WriteFM(chip, opcellnum, ins^.SoundCharacteristic[0]);
  139.   inc(opcellnum, 3);
  140.   WriteFM(chip, opcellnum, ins^.SoundCharacteristic[1]);
  141.   opcellnum:=$40 + celloffset;
  142.   WriteFM(chip, opcellnum, ins^.level[0]);
  143.   inc(opcellnum, 3);
  144.   WriteFM(chip, opcellnum, ins^.Level[1]);
  145.   opcellnum:=$60 + celloffset;
  146.   WriteFM(chip, opcellnum, ins^.AttackDecay[0]);
  147.   inc(opcellnum, 3);
  148.   WriteFM(chip, opcellnum, ins^.AttackDecay[1]);
  149.   opcellnum:=$80 + celloffset;
  150.   WriteFM(chip, opcellnum, ins^.SustainRelease[0]);
  151.   inc(opcellnum, 3);
  152.   WriteFM(chip, opcellnum, ins^.SustainRelease[1]);
  153.   opcellnum:=$E0 + celloffset;
  154.   WriteFM(chip, opcellnum, ins^.WaveSelect[0]);
  155.   inc(opcellnum, 3);
  156.   WriteFM(chip, opcellnum, ins^.WaveSelect[1]);
  157.   opcellnum:=$C0 + voicenum;
  158.   WriteFM(chip, opcellnum, ins^.feedback);
  159. end;
  160. end.
  161.  
  162. {
  163. Message 1 is FMTEST.PAS
  164. Messages 2+3 are SBFM.PAS
  165. That's all.  One thing: if you can make this work with more than two
  166. voices at a time, I'd be interested in improved code.  I think that this
  167. code uses the AdLib compatibility, which is by no means impressive :-).
  168. }
  169.